home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbactlf.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-09  |  6.5 KB  |  160 lines
  1. (*===========================================================================*)
  2. (* Make a file from a message as an action (not a command)                   *)
  3. (*                                                                           *)
  4. (*   Copyright 1990, 1992 by H. Roy Engehausen.  All rights reserved.        *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. PROCEDURE do_make_file;
  9.  
  10.   VAR
  11.     kill_sw      : BOOLEAN;
  12.     search_info  : search_block_type;
  13.     this_msg     : msg_index_ptr;
  14.     to_this_file : file_name_str;
  15.     write_mode   : BYTE;
  16.  
  17.   LABEL
  18.     do_next_file;
  19.  
  20.   BEGIN;
  21.  
  22.     kill_sw := POS('K', options_str) <> 0;
  23.  
  24.     (*-----------------------------------------------------------------------*)
  25.     (* Save the name of the file pattern to use                              *)
  26.     (*-----------------------------------------------------------------------*)
  27.  
  28.     to_this_file := s2;
  29.  
  30.     (*-----------------------------------------------------------------------*)
  31.     (* Build the search arguement                                            *)
  32.     (*-----------------------------------------------------------------------*)
  33.  
  34.     set_search(s1, @search_info);
  35.     IF active_tcb^.error_sw THEN
  36.       BEGIN;
  37.         send_tnc_data_str('Invalid search on action -- ' + s1 + cr);
  38.         free_task_mem('MSB', TRUE);
  39.       END;
  40.  
  41.     (*-----------------------------------------------------------------------*)
  42.     (* Prepare to do the search                                              *)
  43.     (*-----------------------------------------------------------------------*)
  44.  
  45.     search_info.search_last := NIL;
  46.     search_info.search_nok  := FALSE;
  47.  
  48.     GOTO do_next_file;
  49.  
  50.     (*-----------------------------------------------------------------------*)
  51.     (* Search loop                                                           *)
  52.     (*-----------------------------------------------------------------------*)
  53.  
  54.     REPEAT
  55.  
  56.       (*---------------------------------------------------------------------*)
  57.       (* Put msg pointer somewhere handy                                     *)
  58.       (*---------------------------------------------------------------------*)
  59.  
  60.       this_msg := search_info.search_last;
  61.  
  62.       (*---------------------------------------------------------------------*)
  63.       (* If this message already archived then skip it                       *)
  64.       (*---------------------------------------------------------------------*)
  65.  
  66.       IF (this_msg^.msg_i_mb.msg_flag AND mf_archive) <> 0 THEN
  67.         GOTO do_next_file;
  68.  
  69.       (*---------------------------------------------------------------------*)
  70.       (* Build the file name by putting the current msg info to the right    *)
  71.       (* spot and translating the file name pattern into a real file name    *)
  72.       (*---------------------------------------------------------------------*)
  73.  
  74.       s2 := to_this_file;
  75.  
  76.       active_tcb^.curr_msg := this_msg^;
  77.  
  78.       substitute_line(s2);
  79.  
  80.       (*---------------------------------------------------------------------*)
  81.       (* Convert the file                                                    *)
  82.       (*---------------------------------------------------------------------*)
  83.  
  84.       IF action_word = 'MAKE_FILE_REPLACE' THEN
  85.         write_mode := 1
  86.       ELSE
  87.         IF action_word = 'MAKE_FILE_APPEND' THEN
  88.           write_mode := 2
  89.         ELSE
  90.           write_mode := 0;
  91.  
  92.       (*---------------------------------------------------------------------*)
  93.       (* Convert the file                                                    *)
  94.       (*---------------------------------------------------------------------*)
  95.  
  96.       read_a_msg(this_msg, s2, write_mode, FALSE, TRUE);
  97.  
  98.       (*---------------------------------------------------------------------*)
  99.       (* Get ready to give message                                           *)
  100.       (*---------------------------------------------------------------------*)
  101.  
  102.       STR(this_msg^.msg_i_mb.msg_number, s1);
  103.  
  104.       (*---------------------------------------------------------------------*)
  105.       (* If we failed, send the failed message                               *)
  106.       (*---------------------------------------------------------------------*)
  107.  
  108.       IF active_tcb^.error_sw THEN
  109.         BEGIN;
  110.           send_tnc_data_str('Attempt to convert message ' + s1
  111.                              + ' to file ' + s2 + ' failed' + cr);
  112.           GOTO do_next_file;
  113.  
  114.         END;
  115.  
  116.       (*---------------------------------------------------------------------*)
  117.       (* If we succeeded, update the archive flag                            *)
  118.       (*---------------------------------------------------------------------*)
  119.  
  120.       this_msg^.msg_i_mb.msg_flag := this_msg^.msg_i_mb.msg_flag OR mf_archive;
  121.  
  122.       update_msg(this_msg);
  123.  
  124.       (*---------------------------------------------------------------------*)
  125.       (* Tell user we succeeded                                              *)
  126.       (*---------------------------------------------------------------------*)
  127.  
  128.       send_tnc_data_str('Message ' + s1 + ' converted to file ' + s2 + cr);
  129.  
  130.       (*---------------------------------------------------------------------*)
  131.       (* Kill?                                                               *)
  132.       (*---------------------------------------------------------------------*)
  133.  
  134.       IF kill_sw AND NOT active_tcb^.error_sw THEN
  135.         kill_a_msg(this_msg, TRUE);
  136.  
  137.       (*---------------------------------------------------------------------*)
  138.       (* Conduct next search                                                 *)
  139.       (*---------------------------------------------------------------------*)
  140.  
  141. do_next_file:
  142.  
  143.       search_msg(@search_info);
  144.  
  145.     UNTIL search_info.search_last = NIL; (*----- End of search loop ---------*)
  146.  
  147.     (*-----------------------------------------------------------------------*)
  148.     (* Free any left over memory                                             *)
  149.     (*-----------------------------------------------------------------------*)
  150.  
  151.     free_task_mem('MSB', TRUE);
  152.  
  153.     (*-----------------------------------------------------------------------*)
  154.     (* Leave some time                                                       *)
  155.     (*-----------------------------------------------------------------------*)
  156.  
  157.     task_switch;
  158.  
  159.   END;
  160.